*  FILE NAME: INVBA.PRG
*  BY: NURJADI PURNAMA
*  DATE: April 17, 1996
*  DESC:
*  CALLED BY:
*  DATA FILES: DRUGS.DBF, DISP.DBF, DRUG_ENT.DBF, DISP_ENT.DBF, INVLOG.DBF
**
**
**
DR1='N:'
F1='DISPOS'
F2='DRUG_ENT'
STORE 0 TO PL3,PL4,PL5,PL6,BNUM,BNUM1,PRICE,pl7,PL8,PL9,PL11,PL11T
STORE .F. TO TEMU

   F3='SUPPLIER'
   F9='PUR_DRUG'
   F10='PUR_DISP'


STORE SPACE(10) TO REFNO
STORE SPACE(60) to REMARK
STORE 0 TO ADJOPT
STORE ' ' TO ADJTYPE, ADJDESC, ADJCODE

DO WHILE PL6<>2 .AND. LASTKEY()<>27
   SET COLOR TO BG/B
   @ 10,1 clear to 10,45
   @11,1 CLEA TO 23,78

** dickson (15/12/98)  -
   
   SET COLOR TO n/bg, w+/n
   @ 11,3 CLEAR TO 16,38
   @ 11,4  TO 16,37 DOUBLE
   @ 12, 5 PROMPT "GOODS RECEIVED FROM SUPPLIERS "
   @ 13, 5 PROMPT "REVERSAL ON GOODS RECEIVED    "
   @ 15, 5 PROMPT "GOODS TRANSFER / ADJUSTMENT   "
   MENU TO ADJOPT

   SET COLOR TO BG+/B,W+/N
   DO CASE
        CASE ADJOPT = 1
             ADJTYPE = " - Goods Received from Suppliers"
             ADJDESC = " Received : "
             ADJCODE = "RCV"

        CASE ADJOPT = 2
             ADJTYPE = " - Reversal on Goods Received"
             ADJDESC = " Reversed : "
             ADJCODE = "REV"

        CASE ADJOPT = 3
             ADJTYPE = " - Goods Transfer In / Out"
             ADJDESC = " Transfer/Adj:"
             ADJCODE = "TRF"

   ENDCASE

   @ 3,3 CLEAR TO 6,70    
   DO BOXT WITH 4,3,"ENTRY IN STORE"+ADJTYPE,'W+','BG',.T.,.T.

   ORDRU=ORDRU+1
   F1='Drugs'
   F11='DrugNM'
   F2='Drug_ENT'
   F7='DISPOS'
   F71='DISPNM'
   F8='DISP_ENT'

** Dickson (15/12/98) - new log file for Goods Recv/Trasnsfer/Adj/ Reversal
**
   F9='INVLOG'
   SELE 9
   USE &DR1&F9
   SET EXCLU OFF
**              -- end Dickson

   SELE 2
   SET EXCLU OFF
   USE &DR1&F2
   SELE 1
   SET EXCLU OFF
   USE &DR1&F1 INDEX &DR1&F1,&DR1&F11
   SELE 8
   SET EXCLU OFF
   USE &DR1&F8
   SELE 7
   SET EXCLU OFF
   USE &DR1&F7 INDEX &DR1&F7,&DR1&F71
   IF LASTKEY()=27
      LOOP
   ENDIF
   CNT=0
   KODE=SPACE(4)
   kunci=space(5)
   do boxe with 11,3,'Enter Initial of Drug/Disposable Name : ','KUNCI','N','BG','W+','N',5,.T.,.T.
   if lastkey()=27
      set colo to bg+/b,w+/n
      loop
   endif
   DO GETPHAR
   IF CNT=0 .or. lastkey()=27
      set colo to bg+/b,w+/n
      LOOP
   ENDIF
   SET COLO TO BG+/B,W+/N
   @ 8,1 CLEAR TO 23,78
   SELE 1
   SET EXCLU OFF


   USE &dr1&F1 INDEX &dr1&F1
   SEEK KODE
   IF EOF()
      SELE 7
      SET EXCLU OFF
      USE &dr1&F7 INDEX &dr1&F7
      SEEK KODE
      IF EOF()
         PL3=0
         DO BOX2 WITH 8,3,'NO ITEM WITH THIS CODE NUMBER ... DO YOU WANT TO :','RETRY','CANCEL','GR+','R','W+','N',PL3,.T.,.T.
         IF PL3=2 .OR. LASTKEY()=27
            RETURN
         ENDIF
         LOOP
      ELSE
         PL11=2
      ENDIF
   ELSE
      PL11=1
   ENDIF
   SEL=ALLTRIM(SELL_UNIT)
   BUY=ALLTRIM(BUY_UNIT)
   LBUY=LEN(BUY)
   RAT=BUY_SELL_R
   NRAT=ALLTRIM(TRANS(RAT,'9,999'))
   NBUY=ALLTRIM(TRANS(ST_ACT_BUY,'9,999'))
   NSEL=ALLTRIM(TRANS(ST_ACT_SELL,'9,999'))
   DO INVAL

** Dickson (15/12/98)

     @ 20,3 CLEAR TO 23,78
**   DO BOXT WITH 12,1,  "Total units bought : "+ALLTRIM(TRANS(ST_ACT_BUY,'9999'))+'  ','W+','B',.F.,.F.
**   DO BOXT WITH 12,40, "Existing average cost : "+ALLTRIM(TRANS(ST_AV_PR_S,'999.99'))+' ','W+','B',.F.,.F.
     @ 12,3  SAY "Total Physical Balance : "+ALLTRIM(TRANS(ST_ACT_TOT,'9999'))
     @ 12,41 SAY "Existing average unit cost : "+ ALLTRIM(TRANS(ST_AV_PR_S,'999.99'))

** Dickson 
   SET COLO TO BG+/B,W+/N
*   IF .NOT. ST_REORDER
*      IF PL11=1
*         DO BOXF WITH 13,3,">>> THIS DRUGS ITEM HAS NOT BEEN ORDERED <<<",'GR+','R','GR+*',.T.,.T.
*      ELSE
*         DO BOXF WITH 13,3,">>> THIS DISPOSABLE ITEM HAS NOT BEEN ORDERED <<<",'GR+','R','GR+*',.T.,.T.
*      ENDIF
*      wait ''
*      loop
*   ELSE
*      BNUM = ST_RE_QANT
*   ENDIF
*   SNUM=BNUM*BUY_SELL_R

   PL4=0
   DO BOX2 WITH 20,3,'DO YOU WANT TO :','CONFIRM','CANCEL','GR+','R','W+','N',PL4,.T.,.T.

   SET COLOR TO BG/B
   @ 20,3 CLEAR TO 23,78

   DO CASE
   CASE PL4=2
      ORDRU=ORDRU-1
      LOOP
   CASE PL4=1
      TEMU=.F.
      PL11T=0
      IF PL11=1
         SELE 1
      ELSE
         SELE 7
      ENDIF
      PROS='N'
      LYY=SAVESCREEN(0,0,24,79)
      PL5=0
      DO WHILE pl5=0 .and. lastkey()<>27
         BNUM1=0
         SET COLOR TO BG/B
*         @ 10,1 CLEA TO 23,78
*         DO BOXNE WITH 15,3,"QUANTITY RECEIVED :",'BNUM1','99,999','B+','W+','W+','N','bnum1','0',.T.,.T.
**         DO BOXNI WITH 15,3,"QUANTITY RECEIVED :",'BNUM1','99,999','B+','W+','W+','N','bnum1','0',.T.,.T.
**      dickson (15/12/98)
         SET COLOR TO  BG+/B, W+/N
         @ 14,3 SAY "Quantity "+ADJDESC  
         @ 14,28 GET BNUM1 PICT '99,999'
         READ

**         ' For Reversal Of Goods Received .. set it to -ve Qty
         IF ADJOPT = 2
            IF BNUM1 > 0
               BNUM1 = BNUM1 * -1
            ENDIF
         ENDIF 
** end - dickson


         SNUM1=BNUM1*BUY_SELL_R

** Dickson (15/12/98) -- Only need to update the Avg Cost price for
**    Goods Received transaction only. Other txn should not chg the avg cost
**
**
**    to get the original cost price of the item from the drugs/ disposable file.
      PRICE = ST_AV_PR_S

**
**    if it is a Goods Receive or Reversal of Goods Received then get the price  from users key-in
      IF ADJOPT = 1  .OR. ADJOPT = 2
         PRICE=0
         IF AEADECI
*            do boxNE with 11,41,"TOTAL PRICE :     ",'PRICE','99,999.99','B+','W+','W+','N','PRICE','0',.T.,.T.
*            do boxNI with 15,41,"TOTAL PRICE :     ",'PRICE','99,999.99','B+','W+','W+','N','PRICE','0',.T.,.T.
*  dickson (15/12/98)
             @ 14,41 SAY "Total Price : "
             @ 14,55 GET PRICE PICT '99,999.99'
             READ
         ELSE
*            do boxNE with 11,41,"TOTAL PRICE :     ",'PRICE','9,999,999','B+','W+','W+','N','PRICE','0',.T.,.T.
*            do boxNi with 15,41,"TOTAL PRICE :     ",'PRICE','9,999,999','B+','W+','W+','N','PRICE','0',.T.,.T.
*  dickson (15/12/98)
             @ 14,41 SAY "Total Price : "
             @ 14,55 GET PRICE PICT '99,999,999'
             READ
         ENDIF

**         ' Set the amount to -ve for Reversal of Goods Received 
         IF ADJOPT = 2
            IF PRICE > 0
               PRICE = PRICE * -1
            ENDIF
         ENDIF
      ENDIF

*  dickson (15/12/98)  - add in new field - REMARKS
**             REFNO = SPACE(10)
             @ 15,3 SAY "Ref # : "
             @ 15,12 GET REFNO

**             REMARK  = SPACE(60)
             @ 16,3 SAY "Remarks : "
             @ 16,12 GET REMARK


             READ
  

         SET COLO TO BG+/B,W+/N
         @ 17,2 CLEAR TO 18,78
         do boxt with 17,1,"NEW QUANTITY IN STORE : "+trans(ROUND(ST_ACT_TOT+BNUM1,0),"999,999"),'w+','b',.f.,.f.

**
**   Dickson (15/12/98)  - only need to chg the Avg Cost price for
**      Goods Received txn only, other than that, the avg cost price remain
**
**   if the current quantity is already be -ve, then new AVR Cost Price
**     is equal to the current price fomr the Goods Received Notes (or D.O.)

         IF ADJOPT = 1  .OR. ADJOPT = 2
            IF ST_ACT_TOT < 0
               AVPRS = PRICE / SNUM1
            ELSE
               IF ST_ACT_TOT+SNUM1>0
                  AVPRS=((ST_AV_PR_S*ST_ACT_TOT)+PRICE)/(ST_ACT_TOT+SNUM1)
               ELSE
                  AVPRS=0
               ENDIF
            ENDIF
            AVPRB=AVPRS*BUY_SELL_R
         ELSE
            AVPRS =  ST_AV_PR_s
            AVPRB =  ST_AV_PR_B
         ENDIF

         IF AEADECI
             do boxT with 17,39,"NEW AVERAGE PRICE :     "+TRANS(ROUND(AVPRB,2),"999.99"),'w+','b',.f.,.f.
         ELSE
             do boxT with 17,39,"NEW AVERAGE PRICE :     "+TRANS(ROUND(AVPRB,2),"999.99"),'w+','b',.f.,.f.
         ENDIF

     
     
         set colo to bg+/b,w+/n
         @ 20,1 clea to 23,78
         DO BOX2 WITH 20,3,'DO YOU WANT TO :','CONFIRM','CANCEL','GR+','R','W+','N',PL5,.T.,.T.
         DO CASE
         CASE pl5=2 .or. lastkey()=27
            IF LASTKEY()=27
               RETURN
            ENDIF
            PL5=0
         CASE pl5=1
            IF PL11=1
               SELE 1
               IF REC_LOCK(0)
**                  REPL ST_AV_PR_S WITH AVPRS,ST_ACT_BUY WITH ST_ACT_BUY+BNUM1,ST_ACT_TOT WITH ST_ACT_TOT+SNUM1
                  REPL ST_AV_PR_S WITH AVPRS,ST_ACT_TOT WITH ST_ACT_TOT+SNUM1,ST_ACT_BUY WITH ST_ACT_TOT  
                  REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R),DT_L_PURC WITH DATE(),ST_AV_PR_B WITH AVPRB

**                  REPL U_PR_L_PUR WITH price/bnum1,QANT_L_PUR WITH BNUM1,ST_RE_QANT WITH ST_RE_QANT-BNUM1
**       Amended by dickson - if Not Goods Received/ Reversal of Goods Received then don't update the Last Purchase Price
                  REPL QANT_L_PUR WITH BNUM1,ST_RE_QANT WITH ST_RE_QANT-BNUM1

                  IF ADJOPT = 1  .OR. ADJOPT = 2
                     REPL U_PR_L_PUR WITH price/bnum1
                  ENDIF
**       End amend dickson

               ENDIF
               UNLOCK
            ELSE
               SELE 7
               IF REC_LOCK(0)
**                  REPL ST_AV_PR_S WITH AVPRS,ST_ACT_BUY WITH ST_ACT_BUY+BNUM1,ST_ACT_TOT WITH ST_ACT_TOT+SNUM1
                  REPL ST_AV_PR_S WITH AVPRS,ST_ACT_TOT WITH ST_ACT_TOT+SNUM1,ST_ACT_BUY WITH ST_ACT_TOT  
                  REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R),DT_L_PURC WITH DATE(),ST_AV_PR_B WITH AVPRB

**                  REPL U_PR_L_PUR WITH price/bnum1,QANT_L_PUR WITH BNUM1,ST_RE_QANT WITH ST_RE_QANT-BNUM1
**       Amended by dickson - if Not Goods Received/ Reversal of Goods Received then don't update the Last Purchase Price
                  REPL QANT_L_PUR WITH BNUM1,ST_RE_QANT WITH ST_RE_QANT-BNUM1

                  IF ADJOPT = 1  .OR. ADJOPT = 2
                     REPL U_PR_L_PUR WITH price/bnum1
                  ENDIF
**       End amend dickson

               ENDIF
               UNLOCK
            ENDIF
         ENDCASE
      ENDDO
      IF PL11=1
         SELE 2
         IF FIL_LOCK(0)
            APPEND BLANK
         ENDIF
         IF REC_LOCK(0)
            REPL ENTRY_DATE WITH DATE()
**
**    28-10-2000 Dickson - ENTRY_ORDR is a 2 digit '99' numeric number
*                        - reset it to 1 if > 99 to avoid Data width error b4 write to the file
            IF ORDRU > 99
               ORDRU = 1
            ENDIF
**  end 28-10-2000
            REPL ENTRY_ORDR WITH ORDRU
            REPL DRUG_CODE WITH A->DRUG_CODE
            REPL DRUG_NAME WITH A->DRUG_NAME,DRUG_TYPE WITH A->DRUG_TYPE,DRUG_QANT WITH A->DRUG_QANT,DRUG_UNIT WITH A->DRUG_UNIT
            REPL BUY_UNIT  WITH A->BUY_UNIT,ENT_QANT  WITH BNUM1,ENT_PRICE WITH AVPRB,ENT_AMOUNT WITH PRICE,ENTR_PRINT WITH .F.
         ENDIF
         UNLOCK
      ELSE
         SELE 8
         IF FIL_LOCK(0)
            APPEND BLANK
         ENDIF
         IF REC_LOCK(0)
**
**    28-10-2000 Dickson - ENTRY_ORDR is a 2 digit '99' numeric number
*                        - reset it to 1 if > 99 to avoid Data width error b4 write to the file
            IF ORDRU > 99
               ORDRU = 1
            ENDIF
**  end 28-10-2000

            REPL ENTRY_DATE WITH DATE(),ENTRY_ORDR WITH ORDRU,DISP_CODE WITH G->DISP_CODE
            REPL DISP_NAME WITH G->DISP_NAME,DISP_TYPE WITH G->DISP_TYPE,DISP_QANT WITH G->DISP_QANT,DISP_UNIT WITH G->DISP_UNIT
            REPL BUY_UNIT  WITH G->BUY_UNIT,ENT_QANT  WITH BNUM1,ENT_PRICE WITH AVPRB,ENT_AMOUNT WITH PRICE,ENTR_PRINT WITH .F.
         ENDIF
         UNLOCK
      ENDIF

** Dickson (15/12/98) -- Add a txn log record for the auditi trial / with remark field
      SELE 9
      IF FIL_LOCK(0)
         APPEND BLANK
      ENDIF
      IF REC_LOCK(0)
         REPL INV_DATE   WITH DATE()
         REPL INV_CODE   WITH KODE
         REPL INV_TYPE   WITH ADJCODE 
         REPL INV_QANT   WITH BNUM1
         REPL INV_PRICE  WITH PRICE
         REPL INV_REFNO  WITH REFNO
         REPL INV_USER   WITH  ' '
         REPL INV_REMARK WITH  REMARK

      ENDIF
      UNLOCK
      SELE 1
      DO BOX2 WITH 20,3,'DO YOU WANT TO RECORD ANOTHER ENTRY :','YES','NO','GR+','R','W+','N',PL6,.T.,.T.
   ENDCASE
ENDDO
set color to bg/b
@ 10,1 clea to 23,78
RETURN

*Formatted by: Herman T Ver. 7.1  on April 17, 1996.
